perm filename PACKER.FOR[P11,LCS] blob
sn#414652 filedate 1979-01-30 generic text, type T, neo UTF8
DIMENSION I(80)
DATA IBLA/' '/
1 FORMAT(80A1)
2 FORMAT(' TYPE'/)
3 FORMAT(1XA4)
4 TYPE 2
ACCEPT 1,I
N=1
DO 6 J=80,1,-1
6 IF(I(J).NE.IBLA)GO TO 7
7 DO 5 K=1,J+1
IF(I(K).NE.IBLA)GO TO 5
CALL PACKER(X,I(N))
TYPE 3,X
N=K+1
5 CONTINUE
GO TO 4
END
SUBROUTINE PACKER(NAM,INP)
DATA IBLA/' '/,ISEMI/';'/,IARO/"575004020100/,IEQU/'='/
C****** THE BIG NUMBER=LEFT ARROW
C11 DOUBLE PRECISION NAM
DIMENSION INP(1),KNM(5)
DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
1 , MM/"774000000000/
NAM=0
DO 1 J=1,80
N=INP(J)
IF(N.EQ.IARO.OR.N.EQ.IEQU)GO TO 2
1 IF(N.EQ.IBLA.OR.N.EQ.ISEMI)GO TO 2
2 II=J
J=J-1
N=J
IF(J.GT.4)N=4
4 DO 10 K=1,4
IF(K.GT.N)GO TO 11
KNM(K)=INP(K)
GO TO 10
11 KNM(K)=IBLA
10 CONTINUE
KNM(5)=IBLA
C ABOVE FOR PDP10 ONLY*********
C N=WDCNT
DO 12 K=5,1,-1
NAM=NAM .OR. (KNM(K) .AND. MM)
IF (K.EQ.1)RETURN
17 IF (NAM.GE.0)GO TO 13
NAM = (( NAM .AND. LL)/KK) .OR. JJ
GO TO 12
13 NAM = NAM / KK
12 CONTINUE
END